home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / vol.com / LABEL.PAS next >
Encoding:
Pascal/Delphi Source File  |  1990-01-19  |  2.5 KB  |  109 lines
  1. program Label_;
  2. uses
  3.    CRT,DOS,VOL;
  4.  
  5. procedure PressKey;
  6. var
  7.    ch : Char;
  8. begin
  9.    write ('Press any key ...');
  10.    ch:= ReadKey;
  11.    If ch = #0 then ch:= ReadKey;
  12.    writeln
  13. end;
  14.  
  15.  
  16. procedure AV (Dr:Drive; V:VolumeName);
  17. begin
  18.    If AddVol (Dr, V) then
  19.       writeln ('New Volume Label Added.')
  20.    else
  21.       writeln ('ERROR Adding New Label.')
  22. end;
  23.  
  24.  
  25. procedure CV (Dr:Drive; V:VolumeName);
  26. begin
  27.    if ChgVol (Dr, V) then
  28.       writeln ('Volume Label Changed.')
  29.    else
  30.       writeln ('ERROR Changing Label.')
  31. end;
  32.  
  33.  
  34. procedure DV (Dr:Drive);
  35. begin
  36.    If DelVol (Dr) then
  37.       writeln ('Volume Label Deleted.')
  38.    else
  39.       writeln ('ERROR Deleting Label.')
  40. end;
  41.  
  42. (*                          MAIN PROGRAM                             *)
  43. var
  44.    Dr     : Drive;
  45.    D      : string[2];
  46.    V      : VolumeName;
  47.    OV     : VolumeName;
  48.    RD     : char;
  49.    Exists : boolean;
  50. begin
  51.    writeln;
  52.    writeln;
  53.    if ParamCount = 0 then
  54.       begin
  55.          repeat
  56.          write ('Drive: ');
  57.          D:= upcase (readkey);
  58.          if D = #27 then
  59.             D:= #64
  60.          until D [1] in [#64..#97];
  61.       end
  62.    else
  63.       D:= ParamStr(1);
  64.    Dr:= ord (upcase (D [1])) - 64;
  65.    if Dr in [1..26] then
  66.       begin
  67.          if ParamCount = 0 then
  68.             writeln (D, ':');
  69.          V:= GetVol (Dr);
  70.          Exists:= V <> '';
  71.          if Exists then
  72.             begin
  73.                writeln ('Current label of drive ', D,' is ', V);
  74.                writeln ('R)elabel, D)elete, or [Esc]?')
  75.             end
  76.          else
  77.             begin
  78.                writeln ('Drive ', D,' has no label');
  79.                writeln ('write new label?  [Y/N]')
  80.             end;
  81.          RD:= upcase (readkey);
  82.          if RD in ['R','Y'] then
  83.             begin
  84.                if ParamCount = 2 then
  85.                   V:= ParamStr (2)
  86.                else
  87.                   begin
  88.                      write ('New Volume Label (max 11 chars): ');
  89.                      readln (V)
  90.                   end;
  91.                writeln;
  92.                if Length (V) > 0 then
  93.                   if Exists then
  94.                      CV (Dr, V)
  95.                   else
  96.                      AV (Dr, V)
  97.             end
  98.          else
  99.             if Exists and (RD = 'D') then
  100.                DV (Dr);
  101.          if (RD <> #27)
  102.           and (V <> '') then
  103.             begin
  104.                writeln;
  105.                PressKey
  106.             end
  107.       end
  108. end.
  109.